home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
cocktail
/
cg.lha
/
cg
/
src
/
Order.mi
< prev
next >
Wrap
Text File
|
1992-11-24
|
50KB
|
2,108 lines
IMPLEMENTATION MODULE Order;
IMPORT SYSTEM, System, IO, Tree;
(* line 11 "" *)
FROM SYSTEM IMPORT TSIZE, ADR;
FROM Memory IMPORT Alloc, Free;
FROM DynArray IMPORT MakeArray;
FROM IO IMPORT StdOutput, WriteI, WriteS, WriteNl;
FROM Idents IMPORT WriteIdent;
FROM Sets IMPORT
tSet , MakeSet , ReleaseSet , IsElement ,
Extract , AssignEmpty , Minimum , Maximum ,
Include , Exclude , Union ;
FROM Relations IMPORT
tRelation , MakeRelation , ReleaseRelation, Closure ,
HasReflexive , IsRelated , Assign , Difference ,
IsCyclic , GetCyclics , WriteRelation ;
FROM Queue IMPORT
MakeQueue , ReleaseQueue , IsEmpty , Enqueue , Dequeue ;
FROM Tree IMPORT
NoTree , tTree , tInstance , Referenced ,
Computed , Reverse , Write , Read ,
Inherited , Synthesized , Input , Output ,
Stack , Variable ,
CopyDef , CopyUse , Thread , Test ,
Left , Right , Def , Use ,
ChildUse , ParentUse , NonBaseComp , First ,
Dummy , Demand , f , WriteName ,
WriteInstance, WriteDependencies, WriteClassProperties, WriteCyclics,
WriteClass , MaxVisit , MaxSet ,
GrammarClass , cLNC , cDNC , cLAG , cOAG , cSAG , cSNC , cWAG,
Options , ForallClasses , ForallAttributes, tSetOfRel ,
tSetOfRelPtr ;
FROM Optimize IMPORT LifeTime1, LifeTime3,
ChildrenIn, ChildrenDyn, AttributeIn, AttributeOut, AttributeTree,
AttributeParam, AttributeVar, AttributeDemand, AttributeStack;
IMPORT Sets, Relations, Queue, Errors;
CONST
GrammarIsInNormalForm = 50 ;
GrammarIsNotInNormalForm = 51 ;
SwitchedOnOptionL = 52 ;
GrammarIsSAG = 53 ;
GrammarIsLAG = 54 ;
GrammarIsOAG = 55 ;
GrammarIsDNC = 56 ;
GrammarIsSNC = 57 ;
GrammarIsWAG = 58 ;
GrammarIsNotWAG = 59 ;
CycleInSNC = 60 ;
CycleInDNC = 61 ;
CycleInOAG = 62 ;
InternalErrorCompOAG = 63 ;
CycleInWAG = 64 ;
VAR
HasCycle ,
Children ,
Parents ,
Relevant ,
Cyclics ,
IsComputed ,
IsComputable : tSet;
Prio ,
UserIndex ,
ClassCount ,
Kind ,
i, i2, j, k, n, Visit : SHORTCARD;
Reporting ,
Success ,
Stable : BOOLEAN;
ActClass ,
UserClass ,
ChildsClass : tTree;
AttrInstance : tInstance;
IndexSize : LONGINT;
(*
PROCEDURE OptimizeVisits (t: tTree): BOOLEAN;
VAR Success : BOOLEAN;
BEGIN
CASE t^.Kind OF
| Tree.Class :
WITH t^.Class DO
Success := FALSE;
IF OptimizeVisits (Extensions) THEN
n := InstCount;
LOOP
WITH Instance^ [Instance^ [n].Order] DO
IF (Input IN Properties) OR ({Synthesized, Left, Dummy} <= Properties) THEN
ELSE EXIT;
END;
END;
DEC (n);
IF n = 0 THEN EXIT; END;
END;
Success := TRUE;
LOOP
WITH Instance^ [Instance^ [n].Order] DO
IF (Left IN Properties) AND (Attribute^.Child.Partition > 0) AND
(Attribute^.Child.Partition = Visits - 1) THEN
EXIT;
END;
IF {Synthesized, Right} * Properties # {} THEN
Success := FALSE; EXIT;
END;
END;
DEC (n);
IF n = 0 THEN EXIT; END;
END;
IF Success THEN DEC (Visits);
END;
END;
RETURN OptimizeVisits (Next) AND Success;
END;
| Tree.NoClass :
RETURN TRUE;
END;
END OptimizeVisits;
*)
PROCEDURE IsComputable3a (i: SHORTCARD; t: tTree): BOOLEAN;
VAR j : SHORTCARD;
BEGIN
WITH t^.Class DO
FOR j := 1 TO InstCount DO
IF IsRelated (i, j, OAG) AND NOT IsElement (j, IsComputed) THEN
RETURN FALSE;
END;
END;
RETURN TRUE;
END;
END IsComputable3a;
PROCEDURE IsComputable3b (i: SHORTCARD; t: tTree): BOOLEAN;
VAR j : SHORTCARD;
BEGIN
WITH t^.Class DO
IF ({Synthesized, Right} <= Instance^[i].Properties) OR
({Inherited, Left} <= Instance^[i].Properties) THEN
FOR j := 1 TO InstCount DO
IF (First IN Instance^ [j].Properties) AND IsRelated (j, i, OAG) AND
NOT IsElement (j, IsComputed) THEN
RETURN FALSE;
END;
END;
ELSE
FOR j := 1 TO InstCount DO
IF IsRelated (j, i, OAG) AND NOT IsElement (j, IsComputed) THEN
RETURN FALSE;
END;
END;
END;
RETURN TRUE;
END;
END IsComputable3b;
PROCEDURE yyAbort (yyFunction: ARRAY OF CHAR);
BEGIN
IO.WriteS (IO.StdError, 'Error: module Order, routine ');
IO.WriteS (IO.StdError, yyFunction);
IO.WriteS (IO.StdError, ' failed');
IO.WriteNl (IO.StdError);
Exit;
END yyAbort;
PROCEDURE yyIsEqual (yya, yyb: ARRAY OF SYSTEM.BYTE): BOOLEAN;
VAR yyi : INTEGER;
BEGIN
FOR yyi := 0 TO INTEGER (HIGH (yya)) DO
IF yya [yyi] # yyb [yyi] THEN RETURN FALSE; END;
END;
RETURN TRUE;
END yyIsEqual;
PROCEDURE Order (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Ag) THEN
(* line 175 "" *)
WITH t^.Ag DO
(* line 175 "" *)
Order (Classes);
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Class) THEN
(* line 178 "" *)
WITH t^.Class DO
(* line 178 "" *)
Success := TRUE;
ForallClasses (t, CheckNormalForm); (* normal form? *)
IF Success THEN
Tree.Information (GrammarIsInNormalForm, t^.Class.Pos);
ELSE
Tree.Information (GrammarIsNotInNormalForm, t^.Class.Pos);
END;
IF cLNC IN GrammarClass THEN
ForallClasses (t, CompIndex); (* absolutely non circular? *)
IndexSize := ClassCount + 1;
MakeArray (IndexToClass, IndexSize, TSIZE (tTree));
MakeQueue (ClassCount);
MakeSet (HasCycle, ClassCount);
ForallClasses (t, CompIndexToClass);
ForallClasses (t, CompUsers);
WHILE NOT IsEmpty () DO
ActClass := IndexToClass^[Dequeue ()];
Closure (ActClass^.Class.SNC);
CompSNC1 (ActClass^.Class.BaseClass);
FOR UserIndex := Minimum (ActClass^.Class.Users) TO Maximum (ActClass^.Class.Users) DO
IF IsElement (UserIndex, ActClass^.Class.Users) THEN
UserClass := IndexToClass^[UserIndex];
ForallAttributes (UserClass, CompSNC1);
END;
END;
END;
ForallClasses (t, CompSNC2);
IF Sets.IsEmpty (HasCycle) THEN INCL (GrammarClass, cSNC);
ELSIF NOT IsElement (ORD ('L'), Options) THEN
Tree.Information (SwitchedOnOptionL, t^.Class.Pos);
Include (Options, ORD ('L'));
END;
IF cSNC IN GrammarClass THEN
WHILE NOT IsEmpty () DO (* double closure non circular? *)
ActClass := IndexToClass^[Dequeue ()];
Closure (ActClass^.Class.DNC);
ForallClasses (ActClass^.Class.Extensions, CompDNC1);
ForallAttributes (ActClass, CompDNC1);
END;
ReleaseQueue;
Success := TRUE;
ForallClasses (t, CompDNC2);
IF Success THEN INCL (GrammarClass, cDNC);
ELSIF NOT IsElement (ORD ('L'), Options) THEN
Tree.Information (SwitchedOnOptionL, t^.Class.Pos);
Include (Options, ORD ('L'));
END;
IF cDNC IN GrammarClass THEN
(* compute partitions: numbers *)
IF IsElement (ORD ('/'), Options) THEN
ForallClasses (t, CompOAG0a); (* as early as possible *)
ELSE
ForallClasses (t, CompOAG0b); (* as late as possible *)
ForallClasses (t, CompOAG0c);
ForallClasses (t, CompOAG0d);
END;
ForallClasses (t, CompOAG1); (* compute partitions: dependencies *)
Success := TRUE;
ForallClasses (t, CompOAG2); (* ordered ? *)
IF Success THEN INCL (GrammarClass, cOAG);
ELSIF NOT IsElement (ORD ('L'), Options) THEN
Tree.Information (SwitchedOnOptionL, t^.Class.Pos);
Include (Options, ORD ('L'));
END;
IF (cOAG IN GrammarClass) THEN
IF NOT IsElement (ORD ('L'), Options) THEN
(* visit sequences *)
IF IsElement (ORD ('/'), Options) THEN
ForallClasses (t, CompOAG3a); (* as early as possible *)
ELSE
ForallClasses (t, CompOAG3b); (* as late as possible *)
END;
(* Success := OptimizeVisits (t); *) (* optimize sequences *)
IF IsElement (ORD ('0'), Options) THEN
ForallClasses (t, LifeTime1);
(* MakeSet (Children, ClassCount);
MakeSet (Parents , ClassCount);
MakeSet (Relevant, ClassCount);
ForallClasses (t, LifeTime4);
ReleaseSet (Children);
ReleaseSet (Parents );
ReleaseSet (Relevant); *)
IF IsElement (ORD ('3'), Options) THEN
WriteNl (StdOutput);
WriteS (StdOutput, "Attribute Storage Assignment"); WriteNl (StdOutput);
WriteS (StdOutput, "----------------------------"); WriteNl (StdOutput);
WriteNl (StdOutput);
ChildrenDyn := 0;
ChildrenIn := 0;
AttributeIn := 0;
AttributeOut := 0;
AttributeTree := 0;
AttributeParam := 0;
AttributeVar := 0;
AttributeDemand := 0;
AttributeStack := 0;
END;
ForallClasses (t, LifeTime3);
IF IsElement (ORD ('3'), Options) THEN
WriteNl (StdOutput);
IF ChildrenIn > 0 THEN
WriteS (StdOutput, "Children Input ");
WriteI (StdOutput, ChildrenIn, 3); WriteNl (StdOutput);
END;
IF ChildrenDyn > 0 THEN
WriteS (StdOutput, "Children Dynamic ");
WriteI (StdOutput, ChildrenDyn, 3); WriteNl (StdOutput);
END;
IF AttributeIn > 0 THEN
WriteS (StdOutput, "Attribute Input ");
WriteI (StdOutput, AttributeIn, 3); WriteNl (StdOutput);
END;
IF AttributeOut > 0 THEN
WriteS (StdOutput, "Attribute Output ");
WriteI (StdOutput, AttributeOut, 3); WriteNl (StdOutput);
END;
IF AttributeTree > 0 THEN
WriteS (StdOutput, "Attribute Tree ");
WriteI (StdOutput, AttributeTree, 3); WriteNl (StdOutput);
END;
IF AttributeParam > 0 THEN
WriteS (StdOutput, "Attribute Parameter ");
WriteI (StdOutput, AttributeParam, 3); WriteNl (StdOutput);
END;
IF AttributeVar > 0 THEN
WriteS (StdOutput, "Attribute Variable ");
WriteI (StdOutput, AttributeVar, 3); WriteNl (StdOutput);
END;
IF AttributeDemand > 0 THEN
WriteS (StdOutput, "Attribute Demand ");
WriteI (StdOutput, AttributeDemand , 3); WriteNl (StdOutput);
END;
IF AttributeStack > 0 THEN
WriteS (StdOutput, "Attribute Stack ");
WriteI (StdOutput, AttributeStack , 3); WriteNl (StdOutput);
END;
END;
END;
END;
Success := TRUE;
ForallClasses (t, CheckLAG); (* LAG? *)
IF Success THEN INCL (GrammarClass, cLAG); END;
IF cLAG IN GrammarClass THEN
Success := TRUE;
ForallClasses (t, CheckSAG); (* SAG? *)
IF Success THEN INCL (GrammarClass, cSAG); END;
IF cSAG IN GrammarClass THEN
Tree.Information (GrammarIsSAG, t^.Class.Pos);
ELSE
Tree.Information (GrammarIsLAG, t^.Class.Pos);
END; ELSE
Tree.Information (GrammarIsOAG, t^.Class.Pos);
END; ELSE
Tree.Information (GrammarIsDNC, t^.Class.Pos);
END; ELSE
Tree.Information (GrammarIsSNC, t^.Class.Pos);
END; ELSE
ReleaseQueue; (* WAG? *)
MakeQueue (ClassCount);
MakeSet (Relevant, ClassCount);
MakeSet (Cyclics, ClassCount);
Sets.Assign (Cyclics, HasCycle);
WHILE NOT Sets.IsEmpty (Cyclics) DO
InitWAG (IndexToClass^[Extract (Cyclics)]);
END;
Reporting := FALSE;
WHILE NOT Sets.IsEmpty (HasCycle) DO
CheckWAG0 (IndexToClass^[Extract (HasCycle)]);
END;
ReleaseSet (Cyclics);
WHILE NOT IsEmpty () DO
CheckWAG2 (IndexToClass^[Dequeue ()]);
END;
IF Sets.IsEmpty (HasCycle) THEN INCL (GrammarClass, cWAG);
Tree.Information (GrammarIsWAG, t^.Class.Pos);
ELSE
Reporting := TRUE;
WHILE NOT Sets.IsEmpty (HasCycle) DO
CheckWAG2 (IndexToClass^[Extract (HasCycle)]);
END;
Tree.Information (GrammarIsNotWAG, t^.Class.Pos);
END;
ReleaseSet (HasCycle);
ReleaseQueue;
END; ELSE
Tree.Information (GrammarIsNotWAG, t^.Class.Pos);
END;
;
RETURN;
END;
END;
END Order;
PROCEDURE CompIndex (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 388 "" *)
WITH t^.Class DO
(* line 388 "" *)
INC (ClassCount);
Index := ClassCount;
MakeRelation (SNC, InstCount, InstCount);
Assign (SNC, DP);
;
RETURN;
END;
END;
END CompIndex;
PROCEDURE CompIndexToClass (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 398 "" *)
WITH t^.Class DO
(* line 398 "" *)
IndexToClass^ [Index] := t;
MakeSet (Users, ClassCount);
Enqueue (Index);
;
RETURN;
END;
END;
END CompIndexToClass;
PROCEDURE CompUsers (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 407 "" *)
WITH t^.Class DO
(* line 407 "" *)
ActClass := t;
ForallAttributes (t, CompUsers);
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Child) THEN
(* line 411 "" *)
WITH t^.Child DO
(* line 411 "" *)
ChildsClass := Class;
IF ChildsClass # NoTree THEN
Include (ChildsClass^.Class.Users, ActClass^.Class.Index);
END;
;
RETURN;
END;
END;
END CompUsers;
PROCEDURE CompSNC1 (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 421 "" *)
WITH t^.Class DO
(* line 421 "" *)
FOR i := 1 TO AttrCount DO
FOR j := 1 TO AttrCount DO
IF IsRelated (i, j, ActClass^.Class.SNC) THEN
IF NOT IsRelated (i, j, SNC) THEN
Relations.Include (SNC, i, j);
Enqueue (Index);
END;
END;
END;
END;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Child) THEN
(* line 433 "" *)
LOOP
WITH t^.Child DO
(* line 434 "" *)
IF NOT (Class # NoTree) THEN EXIT; END;
(* line 435 "" *)
ChildsClass := Class;
(* line 436 "" *)
IF NOT ((ChildsClass = ActClass) OR Queue . IsElement (ChildsClass ^ . Class . Index)) THEN EXIT; END;
(* line 437 "" *)
FOR i := 1 TO ChildsClass^.Class.AttrCount DO
FOR j := 1 TO ChildsClass^.Class.AttrCount DO
IF IsRelated (i, j, ChildsClass^.Class.SNC) THEN
IF NOT IsRelated (UserClass^.Class.AttrCount + InstOffset + i, UserClass^.Class.AttrCount + InstOffset + j, UserClass^.Class.SNC) THEN
Relations.Include (UserClass^.Class.SNC, UserClass^.Class.AttrCount + InstOffset + i, UserClass^.Class.AttrCount + InstOffset + j);
Enqueue (UserClass^.Class.Index);
END;
END;
END;
END;
;
RETURN;
END;
END;
END;
END CompSNC1;
PROCEDURE CompSNC2 (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 452 "" *)
WITH t^.Class DO
(* line 452 "" *)
IF HasReflexive (SNC) THEN
IF NOT IsElement (ORD ('L'), Options) THEN
Tree.WarningI (CycleInSNC, t^.Class.Pos, Errors.Ident, ADR (Name));
WriteS (StdOutput, "Attribute Dependencies SNC");
WriteNl (StdOutput); WriteNl (StdOutput);
WriteDependencies (t, SNC, MaxSet);
WriteS (StdOutput, "Cyclic Attributes");
WriteNl (StdOutput); WriteNl (StdOutput);
MakeSet (Cyclics, InstCount);
GetCyclics (SNC, Cyclics);
WriteCyclics (t, Cyclics); WriteNl (StdOutput);
ReleaseSet (Cyclics);
END;
Include (HasCycle, Index);
END;
IF IsElement (ORD ('S'), Options) THEN
WriteDependencies (t, SNC, MaxSet);
END;
MakeRelation (DNC, InstCount, InstCount);
Assign (DNC, SNC);
Enqueue (Index);
;
RETURN;
END;
END;
END CompSNC2;
PROCEDURE CompDNC1 (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 479 "" *)
WITH t^.Class DO
(* line 479 "" *)
FOR i := 1 TO ActClass^.Class.AttrCount DO
FOR j := 1 TO ActClass^.Class.AttrCount DO
IF IsRelated (i, j, ActClass^.Class.DNC) THEN
IF NOT IsRelated (i, j, DNC) THEN
Relations.Include (DNC, i, j);
Enqueue (Index);
END;
END;
END;
END;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Child) THEN
(* line 491 "" *)
LOOP
WITH t^.Child DO
(* line 492 "" *)
IF NOT (Class # NoTree) THEN EXIT; END;
(* line 493 "" *)
ChildsClass := Class;
(* line 494 "" *)
FOR i := 1 TO ChildsClass^.Class.AttrCount DO
FOR j := 1 TO ChildsClass^.Class.AttrCount DO
IF IsRelated (ActClass^.Class.AttrCount + InstOffset + i, ActClass^.Class.AttrCount + InstOffset + j, ActClass^.Class.DNC) THEN
IF NOT IsRelated (i, j, ChildsClass^.Class.DNC) THEN
Relations.Include (ChildsClass^.Class.DNC, i, j);
Enqueue (ChildsClass^.Class.Index);
END;
END;
END;
END;
;
RETURN;
END;
END;
END;
END CompDNC1;
PROCEDURE CompDNC2 (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 509 "" *)
WITH t^.Class DO
(* line 509 "" *)
IF HasReflexive (DNC) THEN
IF NOT IsElement (ORD ('L'), Options) THEN
Tree.WarningI (CycleInDNC, t^.Class.Pos, Errors.Ident, ADR (Name));
WriteS (StdOutput, "Attribute Dependencies DNC");
WriteNl (StdOutput); WriteNl (StdOutput);
WriteDependencies (t, DNC, MaxSet);
WriteS (StdOutput, "Cyclic Attributes");
WriteNl (StdOutput); WriteNl (StdOutput);
MakeSet (Cyclics, InstCount);
GetCyclics (DNC, Cyclics);
WriteCyclics (t, Cyclics); WriteNl (StdOutput);
ReleaseSet (Cyclics);
END;
Success := FALSE;
END;
IF IsElement (ORD ('N'), Options) THEN
WriteDependencies (t, DNC, MaxSet);
END;
MakeRelation (OAG, InstCount, InstCount);
Assign (OAG, DNC);
;
RETURN;
END;
END;
END CompDNC2;
PROCEDURE CompOAG0a (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 535 "" *)
WITH t^.Class DO
(* line 535 "" *)
ActClass := t;
IF BaseClass^.Kind = Tree.Class THEN
n := BaseClass^.Class.AttrCount; (* compute partition for
additional attributes only *)
ELSE
n := 0;
END;
k := 0;
REPEAT
INC (k);
REPEAT
Stable := TRUE;
Kind := Inherited;
ForallAttributes (Attributes, CompOAG0a);
UNTIL Stable;
REPEAT
Stable := TRUE;
Kind := Synthesized;
ForallAttributes (Attributes, CompOAG0a);
UNTIL Stable;
UNTIL n = AttrCount;
IF (BaseClass^.Kind = Tree.Class) AND (BaseClass^.Class.Visits > k) THEN
k := BaseClass^.Class.Visits;
END;
Visits := k;
IF MaxVisit < k THEN MaxVisit := k; END;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Child) THEN
(* line 565 "" *)
WITH t^.Child DO
(* line 565 "" *)
IF Partition = 9999 THEN
IF (Input IN Properties) OR
((Properties * {Inherited, Synthesized}) = {}) THEN
Partition := 0; INC (n); RETURN;
END;
IF Kind IN Properties THEN
FOR i := 1 TO ActClass^.Class.AttrCount DO
IF IsRelated (AttrIndex, i, ActClass^.Class.OAG) AND
(ActClass^.Class.Instance^[i].Attribute^.Child.Partition > k) THEN
RETURN;
END;
END;
Partition := k; INC (n); Stable := FALSE;
END;
END;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Attribute) THEN
(* line 582 "" *)
WITH t^.Attribute DO
(* line 582 "" *)
IF Partition = 9999 THEN
IF (Input IN Properties) OR
((Properties * {Inherited, Synthesized}) = {}) THEN
Partition := 0; INC (n); RETURN;
END;
IF Kind IN Properties THEN
FOR i := 1 TO ActClass^.Class.AttrCount DO
IF IsRelated (AttrIndex, i, ActClass^.Class.OAG) AND
(ActClass^.Class.Instance^[i].Attribute^.Attribute.Partition > k) THEN
RETURN;
END;
END;
Partition := k; INC (n); Stable := FALSE;
END;
END;
;
RETURN;
END;
END;
END CompOAG0a;
PROCEDURE CompOAG0b (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 603 "" *)
WITH t^.Class DO
(* line 603 "" *)
ActClass := t;
IF BaseClass^.Kind = Tree.Class THEN
n := BaseClass^.Class.AttrCount; (* compute partition for
additional attributes only *)
ELSE
n := 0;
END;
k := 0;
REPEAT
INC (k);
REPEAT
Kind := Synthesized;
Stable := TRUE;
ForallAttributes (Attributes, CompOAG0b);
UNTIL Stable;
REPEAT
Stable := TRUE;
Kind := Inherited;
ForallAttributes (Attributes, CompOAG0b);
UNTIL Stable;
UNTIL n = AttrCount;
IF (BaseClass^.Kind = Tree.Class) AND (BaseClass^.Class.Visits > k) THEN
k := BaseClass^.Class.Visits;
END;
Visits := k;
IF MaxVisit < k THEN MaxVisit := k; END;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Child) THEN
(* line 633 "" *)
WITH t^.Child DO
(* line 633 "" *)
IF Partition = 9999 THEN
IF (Input IN Properties) OR
((Properties * {Inherited, Synthesized}) = {}) THEN
Partition := 0; INC (n); RETURN;
END;
IF Kind IN Properties THEN
FOR i := 1 TO ActClass^.Class.AttrCount DO
IF IsRelated (i, AttrIndex, ActClass^.Class.OAG) AND
(ActClass^.Class.Instance^[i].Attribute^.Child.Partition > k) THEN
RETURN;
END;
END;
Partition := k; INC (n); Stable := FALSE;
END;
END;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Attribute) THEN
(* line 650 "" *)
WITH t^.Attribute DO
(* line 650 "" *)
IF Partition = 9999 THEN
IF (Input IN Properties) OR
((Properties * {Inherited, Synthesized}) = {}) THEN
Partition := 0; INC (n); RETURN;
END;
IF Kind IN Properties THEN
FOR i := 1 TO ActClass^.Class.AttrCount DO
IF IsRelated (i, AttrIndex, ActClass^.Class.OAG) AND
(ActClass^.Class.Instance^[i].Attribute^.Attribute.Partition > k) THEN
RETURN;
END;
END;
Partition := k; INC (n); Stable := FALSE;
END;
END;
;
RETURN;
END;
END;
END CompOAG0b;
PROCEDURE CompOAG0c (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 671 "" *)
WITH t^.Class DO
(* line 671 "" *)
k := Visits + 1;
ForallAttributes (Attributes, CompOAG0c);
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Child) THEN
(* line 675 "" *)
WITH t^.Child DO
(* line 675 "" *)
IF Partition # 0 THEN Partition := k - Partition; END;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Attribute) THEN
(* line 678 "" *)
WITH t^.Attribute DO
(* line 678 "" *)
IF Partition # 0 THEN Partition := k - Partition; END;
;
RETURN;
END;
END;
END CompOAG0c;
PROCEDURE CompOAG0d (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 685 "" *)
WITH t^.Class DO
(* line 685 "" *)
ActClass := t;
k := 0;
REPEAT
INC (k);
REPEAT
Stable := TRUE;
ForallAttributes (Attributes, CompOAG0d);
UNTIL Stable;
REPEAT
Stable := TRUE;
ForallAttributes (Attributes, CompOAG0e);
UNTIL Stable;
UNTIL k = Visits;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Child) THEN
(* line 700 "" *)
WITH t^.Child DO
(* line 700 "" *)
IF (Partition > k) AND (Synthesized IN Properties) AND
((({Output, Test} * Properties) # {}) OR (({Read, Dummy} * Properties) = {})) THEN
FOR i := 1 TO ActClass^.Class.AttrCount DO
IF IsRelated (AttrIndex, i, ActClass^.Class.OAG) AND
(ActClass^.Class.Instance^[i].Attribute^.Child.Partition > k) THEN
RETURN;
END;
END;
Partition := k; Stable := FALSE;
END;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Attribute) THEN
(* line 713 "" *)
WITH t^.Attribute DO
(* line 713 "" *)
IF (Partition > k) AND (Synthesized IN Properties) AND
((({Output, Test} * Properties) # {}) OR (({Read, Dummy} * Properties) = {})) THEN
FOR i := 1 TO ActClass^.Class.AttrCount DO
IF IsRelated (AttrIndex, i, ActClass^.Class.OAG) AND
(ActClass^.Class.Instance^[i].Attribute^.Attribute.Partition > k) THEN
RETURN;
END;
END;
Partition := k; Stable := FALSE;
END;
;
RETURN;
END;
END;
END CompOAG0d;
PROCEDURE CompOAG0e (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Child) THEN
(* line 730 "" *)
WITH t^.Child DO
(* line 730 "" *)
IF (Partition > k) AND (Inherited IN Properties) AND
((({Output, Test} * Properties) # {}) OR (({Read, Dummy} * Properties) = {})) THEN
FOR i := 1 TO ActClass^.Class.AttrCount DO
WITH ActClass^.Class.Instance^[i] DO
IF IsRelated (AttrIndex, i, ActClass^.Class.OAG) AND
((Inherited IN Properties) AND (Attribute^.Child.Partition > k) OR
(Synthesized IN Properties) AND (Attribute^.Child.Partition >= k)) THEN
RETURN;
END;
END;
END;
Partition := k; Stable := FALSE;
END;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Attribute) THEN
(* line 746 "" *)
WITH t^.Attribute DO
(* line 746 "" *)
IF (Partition > k) AND (Inherited IN Properties) AND
((({Output, Test} * Properties) # {}) OR (({Read, Dummy} * Properties) = {})) THEN
FOR i := 1 TO ActClass^.Class.AttrCount DO
WITH ActClass^.Class.Instance^[i] DO
IF IsRelated (AttrIndex, i, ActClass^.Class.OAG) AND
((Inherited IN Properties) AND (Attribute^.Attribute.Partition > k) OR
(Synthesized IN Properties) AND (Attribute^.Attribute.Partition >= k)) THEN
RETURN;
END;
END;
END;
Partition := k; Stable := FALSE;
END;
;
RETURN;
END;
END;
END CompOAG0e;
PROCEDURE CompOAG1 (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 766 "" *)
WITH t^.Class DO
(* line 766 "" *)
FOR i := 1 TO AttrCount DO
WITH Instance^[i] DO
IF Synthesized IN Properties THEN
FOR j := 1 TO AttrCount DO
IF (Inherited IN Instance^[j].Properties) AND
(Attribute^.Child.Partition = Instance^[j].Attribute^.Child.Partition) THEN
Relations.Include (OAG, i, j);
END;
END;
END;
END;
END;
FOR i := 1 TO AttrCount DO
WITH Instance^[i] DO
IF (Inherited IN Properties) AND (Attribute^.Child.Partition >= 2) THEN
FOR j := 1 TO AttrCount DO
IF (Synthesized IN Instance^[j].Properties) AND
(Attribute^.Child.Partition - 1 = Instance^[j].Attribute^.Child.Partition) THEN
Relations.Include (OAG, i, j);
END;
END;
END;
END;
END;
IF IsElement (ORD ('C'), Options) THEN
MakeRelation (Part, InstCount, InstCount);
Assign (Part, OAG);
Difference (Part, DNC);
WriteDependencies (t, Part, MaxSet); WriteNl (StdOutput);
ReleaseRelation (Part);
END;
;
RETURN;
END;
END;
END CompOAG1;
PROCEDURE CompOAG2 (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 805 "" *)
WITH t^.Class DO
(* line 805 "" *)
ActClass := t;
ForallAttributes (t, CompOAG2);
IF IsCyclic (OAG) THEN
IF NOT IsElement (ORD ('L'), Options) THEN
Tree.WarningI (CycleInOAG, t^.Class.Pos, Errors.Ident, ADR (Name));
WriteS (StdOutput, "Cyclic Attributes and Artificially Introduced Dependencies");
WriteNl (StdOutput); WriteNl (StdOutput);
MakeRelation (Part, InstCount, InstCount);
MakeSet (Cyclics, InstCount);
GetCyclics (OAG, Cyclics);
Assign (Part, OAG);
Difference (Part, DNC);
WriteDependencies (t, Part, Cyclics);
ReleaseRelation (Part);
ReleaseSet (Cyclics);
END;
Success := FALSE;
END;
IF IsElement (ORD ('O'), Options) THEN
WriteDependencies (t, OAG, MaxSet);
END;
;
RETURN;
END;
END;
IF (t^.Kind = Tree.Child) THEN
(* line 828 "" *)
LOOP
WITH t^.Child DO
(* line 829 "" *)
IF NOT (Class # NoTree) THEN EXIT; END;
(* line 830 "" *)
ChildsClass := Class;
(* line 831 "" *)
FOR i := 1 TO ChildsClass^.Class.AttrCount DO
FOR j := 1 TO ChildsClass^.Class.AttrCount DO
IF IsRelated (i, j, ChildsClass^.Class.OAG) THEN
Relations.Include (ActClass^.Class.OAG, ActClass^.Class.AttrCount + InstOffset + i, ActClass^.Class.AttrCount + InstOffset + j);
END;
END;
END;
;
RETURN;
END;
END;
END;
END CompOAG2;
PROCEDURE CompOAG3a (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 912 "" *)
WITH t^.Class DO
(* line 912 "" *)
n := 0; (* strategy: as early as possible *)
MakeSet (IsComputed, InstCount);
MakeSet (IsComputable, InstCount);
FOR i := 1 TO InstCount DO
IF IsComputable3a (i, t) THEN Include (IsComputable, i);
END;
END;
WHILE NOT Sets.IsEmpty (IsComputable) DO
i2 := Minimum (IsComputable);
j := Maximum (IsComputable);
LOOP
IF IsElement (i2, IsComputable) THEN
i := i2;
IF NOT ({Inherited, Left} <= Instance^[i2].Properties) THEN EXIT; END;
END;
INC (i2);
IF i2 > j THEN EXIT; END;
END;
WITH Instance^ [i] DO
INC (n);
Instance^[n].Order := i;
Include (IsComputed, i);
Exclude (IsComputable, i);
INCL (Properties, First);
Visit := Attribute^.Child.Partition;
IF {Inherited, Left} <= Properties THEN
FOR i2 := 1 TO AttrCount DO (* complete visit parent *)
WITH Instance^ [i2] DO
IF NOT IsElement (i2, IsComputed) AND
(Inherited IN Properties) AND
(Attribute^.Child.Partition = Visit) THEN
INC (n);
Instance^[n].Order := i2;
Include (IsComputed, i2);
Exclude (IsComputable, i2);
END;
END;
END;
ELSIF {Synthesized, Right} <= Properties THEN
IF Selector # NoTree THEN (* complete visit child *)
ChildsClass := Selector^.Child.Class;
FOR i2 := AttrCount + Selector^.Child.InstOffset + 1 TO
AttrCount + Selector^.Child.InstOffset + ChildsClass^.Class.AttrCount DO
WITH Instance^ [i2] DO
IF NOT IsElement (i2, IsComputed) AND
(Synthesized IN Properties) AND
(Attribute^.Child.Partition = Visit) THEN
INC (n);
Instance^[n].Order := i2;
Include (IsComputed, i2);
Exclude (IsComputable, i2);
END;
END;
END;
END;
ELSE
FOR i2 := 1 TO InstCount DO (* add group members *) (* optimize! *)
IF NOT IsElement (i2, IsComputed) AND
(Instance^[i2].Action = Action) THEN
INC (n);
Instance^[n].Order := i2;
Include (IsComputed, i2);
Exclude (IsComputable, i2);
END;
END;
END;
FOR i2 := 1 TO InstCount DO
IF NOT IsElement (i2, IsComputed) AND
NOT IsElement (i2, IsComputable) AND
IsComputable3a (i2, t) THEN
Include (IsComputable, i2);
END;
END;
END;
END;
IF n # InstCount THEN
Tree.ErrorI (InternalErrorCompOAG, t^.Class.Pos, Errors.Ident, ADR (Name));
Exclude (Options, ORD ('o'));
END;
ReleaseSet (IsComputed);
ReleaseSet (IsComputable);
IF IsElement (ORD ('G'), Options) THEN WriteOrderDecl (t); END;
IF IsElement (ORD ('E'), Options) THEN WriteOrderEval (t); END;
IF IsElement (ORD ('V'), Options) THEN WriteVisitSequence (t); END;
;
RETURN;
END;
END;
END CompOAG3a;
PROCEDURE CompOAG3b (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 1013 "" *)
WITH t^.Class DO
(* line 1013 "" *)
MakeSet (IsComputed, InstCount); (* strategy: as late as possible *)
n := 0; (* set property First *)
REPEAT
i := InstCount;
LOOP
WITH Instance^ [i] DO
IF NOT IsElement (i, IsComputed) AND IsComputable3a (i, t) THEN
INC (n);
Include (IsComputed, i);
INCL (Properties, First);
Visit := Attribute^.Child.Partition;
IF {Inherited, Left} <= Properties THEN
FOR i2 := 1 TO AttrCount DO (* complete visit parent *)
WITH Instance^ [i2] DO
IF NOT IsElement (i2, IsComputed) AND
(Inherited IN Properties) AND
(Attribute^.Child.Partition = Visit) THEN
INC (n);
Include (IsComputed, i2);
FOR j := 1 TO InstCount DO
IF IsRelated (j, i2, OAG) THEN
Relations.Include (OAG, j, i);
END;
END;
END;
END;
END;
ELSIF {Synthesized, Right} <= Properties THEN
IF Selector # NoTree THEN (* complete visit child *)
ChildsClass := Selector^.Child.Class;
FOR i2 := AttrCount + Selector^.Child.InstOffset + 1 TO
AttrCount + Selector^.Child.InstOffset + ChildsClass^.Class.AttrCount DO
WITH Instance^ [i2] DO
IF NOT IsElement (i2, IsComputed) AND
(Synthesized IN Properties) AND
(Attribute^.Child.Partition = Visit) THEN
INC (n);
Include (IsComputed, i2);
FOR j := 1 TO InstCount DO
IF IsRelated (j, i2, OAG) THEN
Relations.Include (OAG, j, i);
END;
END;
END;
END;
END;
END;
ELSE
FOR i2 := 1 TO InstCount DO (* add group members *) (* optimize! *)
IF NOT IsElement (i2, IsComputed) AND
(Instance^[i2].Action = Action) THEN
INC (n);
Include (IsComputed, i2);
FOR j := 1 TO InstCount DO
IF IsRelated (j, i2, OAG) THEN
Relations.Include (OAG, j, i);
END;
END;
END;
END;
END;
EXIT;
END;
END;
DEC (i);
END;
UNTIL n = InstCount;
AssignEmpty (IsComputed); (* determine order *)
MakeSet (IsComputable, InstCount);
FOR i := 1 TO InstCount DO
IF IsComputable3b (i, t) THEN
Include (IsComputable, i); END;
END;
WHILE NOT Sets.IsEmpty (IsComputable) DO
Prio := 0;
i2 := Minimum (IsComputable);
j := Maximum (IsComputable);
LOOP
IF IsElement (i2, IsComputable) THEN
WITH Instance^[i2] DO
IF ((Test IN Properties) OR NOT (Read IN Properties)) AND (Prio < 1) THEN
i := i2; Prio := 1;
ELSIF ({Inherited, Left} <= Properties) AND (Prio < 2) THEN
i := i2; Prio := 2;
ELSIF (Output IN Properties) AND (Prio < 3) THEN
i := i2; Prio := 3;
ELSE
i := i2; (* Prio := 4; *) EXIT;
END;
END;
END;
INC (i2);
IF i2 > j THEN EXIT; END;
END;
WITH Instance^ [i] DO
Include (IsComputed, i);
Visit := Attribute^.Child.Partition;
IF {Inherited, Left} <= Properties THEN
FOR i2 := 1 TO AttrCount DO (* complete visit parent *)
WITH Instance^ [i2] DO
IF NOT IsElement (i2, IsComputed) AND
(Inherited IN Properties) AND
(Attribute^.Child.Partition = Visit) THEN
Instance^[n].Order := i2;
DEC (n);
Include (IsComputed, i2);
END;
END;
END;
ELSIF {Synthesized, Right} <= Properties THEN
IF Selector # NoTree THEN (* complete visit child *)
ChildsClass := Selector^.Child.Class;
FOR i2 := AttrCount + Selector^.Child.InstOffset + 1 TO
AttrCount + Selector^.Child.InstOffset + ChildsClass^.Class.AttrCount DO
WITH Instance^ [i2] DO
IF NOT IsElement (i2, IsComputed) AND
(Synthesized IN Properties) AND
(Attribute^.Child.Partition = Visit) THEN
Instance^[n].Order := i2;
DEC (n);
Include (IsComputed, i2);
END;
END;
END;
END;
ELSE
FOR i2 := 1 TO InstCount DO (* add group members *) (* optimize! *)
IF NOT IsElement (i2, IsComputed) AND
(Instance^[i2].Action = Action) THEN
Instance^[n].Order := i2;
DEC (n);
Include (IsComputed, i2);
END;
END;
END;
Instance^[n].Order := i;
DEC (n);
Exclude (IsComputable, i);
FOR i2 := 1 TO InstCount DO
IF (First IN Instance^[i2].Properties) AND
NOT IsElement (i2, IsComputed) AND
NOT IsElement (i2, IsComputable) AND
IsComputable3b (i2, t) THEN
Include (IsComputable, i2);
END;
END;
END;
END;
ReleaseSet (IsComputed);
ReleaseSet (IsComputable);
IF n # 0 THEN
CompOAG3a (t);
ELSE
IF IsElement (ORD ('G'), Options) THEN WriteOrderDecl (t); END;
IF IsElement (ORD ('E'), Options) THEN WriteOrderEval (t); END;
IF IsElement (ORD ('V'), Options) THEN WriteVisitSequence (t); END;
END;
;
RETURN;
END;
END;
END CompOAG3b;
PROCEDURE WriteOrderDecl (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 1188 "" *)
WITH t^.Class DO
(* line 1188 "" *)
WriteIdent (StdOutput, Name);
WriteS (StdOutput, " ");
WriteClassProperties (StdOutput, Properties);
WriteNl (StdOutput);
WriteNl (StdOutput);
FOR i := 1 TO InstCount DO
WriteI (StdOutput, i, 2); WriteInstance (Instance^ [i]);
END;
WriteNl (StdOutput);
;
RETURN;
END;
END;
END WriteOrderDecl;
PROCEDURE WriteOrderEval (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 1203 "" *)
WITH t^.Class DO
(* line 1203 "" *)
WriteIdent (StdOutput, Name);
WriteS (StdOutput, " ");
WriteClassProperties (StdOutput, Properties);
WriteNl (StdOutput);
WriteNl (StdOutput);
FOR i := 1 TO InstCount DO
WriteI (StdOutput, Instance^ [i].Order, 2); WriteInstance (Instance^ [Instance^ [i].Order]);
END;
WriteNl (StdOutput);
;
RETURN;
END;
END;
END WriteOrderEval;
PROCEDURE WriteVisitSequence (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 1218 "" *)
WITH t^.Class DO
(* line 1218 "" *)
WriteIdent (StdOutput, Name);
WriteS (StdOutput, " ");
WriteClassProperties (StdOutput, Properties);
WriteNl (StdOutput);
WriteNl (StdOutput);
FOR i := 1 TO InstCount DO
AttrInstance := Instance^ [Instance^ [i].Order];
WITH AttrInstance DO
IF Inherited IN Properties THEN
IF Left IN Properties THEN
IF First IN Properties THEN
WriteS (StdOutput, "visit parent ");
WriteI (StdOutput, Attribute^.Child.Partition, 0);
WriteS (StdOutput, ". time to compute");
WriteNl (StdOutput);
END;
WriteS (StdOutput, " ");
WriteName (AttrInstance);
WriteNl (StdOutput);
END;
IF Right IN Properties THEN
IF First IN Properties THEN
WriteS (StdOutput, "compute ");
ELSE
WriteS (StdOutput, " ");
END;
WriteName (AttrInstance);
WriteNl (StdOutput);
END;
END;
IF Synthesized IN Properties THEN
IF (Left IN Properties) AND NOT (Dummy IN Properties) THEN
IF Test IN Properties THEN
WriteS (StdOutput, "check condition ");
ELSIF First IN Properties THEN
WriteS (StdOutput, "compute ");
ELSE
WriteS (StdOutput, " ");
END;
WriteIdent (StdOutput, Attribute^.Child.Name);
WriteNl (StdOutput);
END;
IF Right IN Properties THEN
IF {First, Dummy} <= Properties THEN
WriteS (StdOutput, "visit ");
WriteIdent (StdOutput, Selector^.Child.Name);
WriteI (StdOutput, Attribute^.Child.Partition, 2);
WriteS (StdOutput, ". time");
WriteNl (StdOutput);
END;
IF NOT (Dummy IN Properties) THEN
IF First IN Properties THEN
WriteS (StdOutput, "visit ");
WriteIdent (StdOutput, Selector^.Child.Name);
WriteI (StdOutput, Attribute^.Child.Partition, 2);
WriteS (StdOutput, ". time to compute");
WriteNl (StdOutput);
END;
WriteS (StdOutput, " ");
WriteName (AttrInstance);
WriteNl (StdOutput);
END;
END;
END;
END;
END;
WriteS (StdOutput, "visit parent");
WriteNl (StdOutput);
WriteNl (StdOutput);
;
RETURN;
END;
END;
END WriteVisitSequence;
PROCEDURE CheckNormalForm (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 1293 "" *)
WITH t^.Class DO
(* line 1293 "" *)
FOR i := 1 TO InstCount DO
IF NOT (Dummy IN Instance^ [i].Properties) THEN
FOR j := 1 TO InstCount DO
IF IsRelated (i, j, DP) THEN
WITH Instance^ [j] DO
IF ({Left, Synthesized} <= Properties) OR
({Right, Inherited} <= Properties) THEN
Success := FALSE; RETURN;
END;
END;
END;
END;
END;
END;
;
RETURN;
END;
END;
END CheckNormalForm;
PROCEDURE CheckLAG (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 1313 "" *)
WITH t^.Class DO
(* line 1313 "" *)
FOR i := AttrCount + 1 TO InstCount DO
FOR j := 1 TO AttrCount DO
IF (Synthesized IN Instance^ [j].Properties) AND
IsRelated (i, j, DP) THEN
Success := FALSE; RETURN;
END;
END;
WITH Instance^ [i] DO
IF Selector # NoTree THEN
ChildsClass := Selector^.Child.Class;
FOR j := AttrCount + Selector^.Child.InstOffset + 1 TO
AttrCount + Selector^.Child.InstOffset + ChildsClass^.Class.AttrCount DO
IF (Synthesized IN Instance^ [j].Properties) AND
IsRelated (i, j, DP) THEN
Success := FALSE; RETURN;
END;
END;
FOR j := AttrCount + Selector^.Child.InstOffset + ChildsClass^.Class.AttrCount + 1 TO InstCount DO
IF IsRelated (i, j, DP) THEN
Success := FALSE; RETURN;
END;
END;
END;
END;
END;
;
RETURN;
END;
END;
END CheckLAG;
PROCEDURE CheckSAG (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 1346 "" *)
WITH t^.Class DO
(* line 1346 "" *)
FOR i := AttrCount + 1 TO InstCount DO
FOR j := 1 TO InstCount DO
IF IsRelated (i, j, DP) THEN
Success := FALSE; RETURN;
END;
END;
END;
;
RETURN;
END;
END;
END CheckSAG;
PROCEDURE InitWAG (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 1358 "" *)
LOOP
WITH t^.Class DO
(* line 1359 "" *)
IF NOT (NOT IsElement (Index, Relevant)) THEN EXIT; END;
(* line 1360 "" *)
Include (Relevant, Index);
(* line 1361 "" *)
ForallAttributes (t, InitWAG);
(* line 1362 "" *)
ForallClasses (Extensions, InitWAG);
RETURN;
END;
END;
END;
IF (t^.Kind = Tree.Child) THEN
(* line 1364 "" *)
WITH t^.Child DO
(* line 1365 "" *)
InitWAG (Class);
RETURN;
END;
END;
END InitWAG;
PROCEDURE CheckWAG0 (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
IF (t^.Kind = Tree.Class) THEN
(* line 1370 "" *)
WITH t^.Class DO
(* line 1371 "" *)
ForallAttributes (t, CheckWAG0);
RETURN;
END;
END;
IF (t^.Kind = Tree.Child) THEN
(* line 1373 "" *)
WITH t^.Child DO
(* line 1374 "" *)
CheckWAG1 (Class);
RETURN;
END;
END;
END CheckWAG0;
PROCEDURE CheckWAG1 (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
| 1: yyR1: RECORD
A: tRelation;
END;
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
(* line 1379 "" *)
WITH yyTempo.yyR1 DO
LOOP
WITH t^.Class DO
(* line 1380 "" *)
;
(* line 1381 "" *)
IF NOT (NOT IsElement (Index, Cyclics)) THEN EXIT; END;
(* line 1382 "" *)
Include (Cyclics, Index);
(* line 1383 "" *)
ReleaseRelation (DNC);
(* line 1384 "" *)
MakeRelation (A, InstCount, InstCount);
(* line 1385 "" *)
Relations . Assign (A, DP);
(* line 1386 "" *)
D := NIL;
(* line 1387 "" *)
CheckWAG5 (t, A);
(* line 1388 "" *)
ReleaseRelation (A);
(* line 1389 "" *)
CheckWAG0 (t);
(* line 1390 "" *)
ForallClasses (Extensions, CheckWAG1);
RETURN;
END;
END;
END;
END CheckWAG1;
PROCEDURE CheckWAG2 (t: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
| 1: yyR1: RECORD
A: tRelation;
END;
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
(* line 1395 "" *)
WITH yyTempo.yyR1 DO
WITH t^.Class DO
(* line 1396 "" *)
;
(* line 1397 "" *)
MakeRelation (A, InstCount, InstCount);
(* line 1398 "" *)
Relations . Assign (A, DP);
(* line 1399 "" *)
ActClass := t;
(* line 1400 "" *)
CheckWAG3 (Attributes, A);
(* line 1401 "" *)
ReleaseRelation (A);
RETURN;
END;
END;
END CheckWAG2;
PROCEDURE CheckWAG3 (yyP2: Tree.tTree; yyP1: tRelation);
VAR yyTempo: RECORD CASE : INTEGER OF
END; END;
BEGIN
IF yyP2 = Tree.NoTree THEN RETURN; END;
IF (yyP2^.Kind = Tree.Child) THEN
(* line 1406 "" *)
WITH yyP2^.Child DO
(* line 1407 "" *)
CheckWAG4 (Class, yyP1, Next, yyP2);
RETURN;
END;
END;
IF (yyP2^.Kind = Tree.NoAttribute) THEN
(* line 1409 "" *)
WITH yyP2^.NoAttribute DO
(* line 1410 "" *)
CheckWAG5 (ActClass, yyP1);
RETURN;
END;
END;
IF (yyP2^.Kind = Tree.Attribute) THEN
(* line 1412 "" *)
WITH yyP2^.Attribute DO
(* line 1414 "" *)
CheckWAG3 (Next, yyP1);
RETURN;
END;
END;
IF (yyP2^.Kind = Tree.ActionPart) THEN
(* line 1412 "" *)
WITH yyP2^.ActionPart DO
(* line 1414 "" *)
CheckWAG3 (Next, yyP1);
RETURN;
END;
END;
END CheckWAG3;
PROCEDURE CheckWAG4 (yyP6: Tree.tTree; yyP5: tRelation; yyP4: Tree.tTree; yyP3: Tree.tTree);
VAR yyTempo: RECORD CASE : INTEGER OF
| 1: yyR1: RECORD
B: tRelation;
ActD: tSetOfRelPtr;
END;
END; END;
BEGIN
IF yyP6 = Tree.NoTree THEN RETURN; END;
IF yyP4 = Tree.NoTree THEN RETURN; END;
IF yyP3 = Tree.NoTree THEN RETURN; END;
(* line 1419 "" *)
WITH yyTempo.yyR1 DO
WITH yyP6^.Class DO
(* line 1420 "" *)
;
(* line 1421 "" *)
MakeRelation (B, ActClass ^ . Class . InstCount, ActClass ^ . Class . InstCount);
(* line 1422 "" *)
ActD := D;
(* line 1423 "" *)
WHILE ActD # NIL DO
Relations.Assign (B, yyP5);
FOR i := 2 TO yyP3^.Child.Class^.Class.AttrCount DO
FOR j := 2 TO yyP3^.Child.Class^.Class.AttrCount DO
IF IsRelated (i, j, ActD^.Relation) THEN
Relations.Include (B, ActClass^.Class.AttrCount + yyP3^.Child.InstOffset + i, ActClass^.Class.AttrCount + yyP3^.Child.InstOffset + j);
END;
END;
END;
CheckWAG3 (yyP4, B);
ActD := ActD^.Next;
END;
ReleaseRelation (B);
;
RETURN;
END;
END;
END CheckWAG4;
PROCEDURE CheckWAG5 (t: Tree.tTree; yyP7: tRelation);
(* line 1439 "" *)
TYPE tSetOfRelPtrPtr = POINTER TO tSetOfRelPtr;
VAR yyTempo: RECORD CASE : INTEGER OF
| 1: yyR1: RECORD
B: tRelation;
ActD: tSetOfRelPtr;
LastNext: tSetOfRelPtrPtr;
END;
END; END;
BEGIN
IF t = Tree.NoTree THEN RETURN; END;
(* line 1441 "" *)
WITH yyTempo.yyR1 DO
WITH t^.Class DO
(* line 1442 "" *)
;
(* line 1443 "" *)
IF Reporting THEN
Tree.ErrorI (CycleInWAG, t^.Class.Pos, Errors.Ident, ADR (Name));
WriteS (StdOutput, "Attribute Dependencies WAG");
WriteNl (StdOutput); WriteNl (StdOutput);
WriteDependencies (t, yyP7, MaxSet);
WriteS (StdOutput, "Cyclic Attributes");
WriteNl (StdOutput); WriteNl (StdOutput);
MakeSet (Cyclics, InstCount);
GetCyclics (yyP7, Cyclics);
WriteCyclics (ActClass, Cyclics); WriteNl (StdOutput);
ReleaseSet (Cyclics);
ELSE
IF (Referenced IN Properties) OR (BaseClass^.Kind = Tree.NoClass) THEN
Closure (yyP7);
IF HasReflexive (yyP7) THEN Include (HasCycle, Index); END;
MakeRelation (B, AttrCount, AttrCount);
FOR i := 2 TO AttrCount DO (* project on left-hand side *)
FOR j := 2 TO AttrCount DO
IF IsRelated (i, j, yyP7) THEN
Relations.Include (B, i, j);
END;
END;
END;
IF Relations.IsEmpty (B) THEN
ReleaseRelation (B);
RETURN;
END;
ActD := D; (* is B already covered by (subset of) some x in D? *)
WHILE ActD # NIL DO
IF Relations.IsSubset (B, ActD^.Relation) THEN
ReleaseRelation (B);
RETURN;
END;
ActD := ActD^.Next;
END;
ActD := D; (* remove all x in D covered by (subset of) B *)
LastNext := ADR (D);
WHILE ActD # NIL DO
IF Relations.IsSubset (ActD^.Relation, B) THEN
ActD := ActD^.Next;
Free (TSIZE (tSetOfRel), LastNext^);
LastNext^ := ActD;
ELSE
LastNext := ADR (ActD^.Next);
ActD := ActD^.Next;
END;
END;
ActD := Alloc (TSIZE (tSetOfRel)); (* include B in D *)
ActD^.Next := D;
ActD^.Relation := B;
D := ActD;
FOR UserIndex := Minimum (Users) TO Maximum (Users) DO
IF IsElement (UserIndex, Users) AND IsElement (UserIndex, Relevant) THEN
Enqueue (UserIndex);
END;
END;
END;
IF BaseClass^.Kind # Tree.NoClass THEN
CheckWAG5 (BaseClass, yyP7);
END;
END;
;
RETURN;
END;
END;
END CheckWAG5;
PROCEDURE BeginOrder;
BEGIN
END BeginOrder;
PROCEDURE CloseOrder;
BEGIN
END CloseOrder;
PROCEDURE yyExit;
BEGIN
IO.CloseIO; System.Exit (1);
END yyExit;
BEGIN
yyf := IO.StdOutput;
Exit := yyExit;
BeginOrder;
END Order.
